home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: delta / whiteline CD Series - delta.iso / progtool / modula2 / module / soundgem.mod < prev    next >
Encoding:
Text File  |  1995-11-25  |  4.6 KB  |  153 lines
  1. MODULE SoundGem;
  2. FROM SYSTEM IMPORT VAL,ADDRESS;
  3. IMPORT DOSound;
  4. FROM Sounds IMPORT Sound,Wave,Volume,Noise,SoundAndNoiseOnOff;
  5. FROM AES IMPORT ResourceGetAddr;
  6. FROM ConvertStr IMPORT StrToCard;
  7. FROM Applications IMPORT Init,Terminate,(*deskx,desky,deskw,deskh,*)
  8.                          InitResource(*,ShowMenuBar,ShowNormal,DeskTree,
  9.                          MenuTree,Colour,Appl*);
  10. FROM EasyDialog IMPORT DoMoveDialog,IsSelected,GetText,IsCrossed;
  11. CONST
  12.       TREE1 = 0;      (* TREE *)
  13.       LAUTST1 = 2;      (* OBJECT in TREE #0 *)
  14.       LAUTST2 = 3;      (* OBJECT in TREE #0 *)
  15.       LAUTST3 = 4;      (* OBJECT in TREE #0 *)
  16.       DREIECK = 11;      (* OBJECT in TREE #0 *)
  17.       SAEGESTG = 14;      (* OBJECT in TREE #0 *)
  18.       SAEGEFAL = 16;      (* OBJECT in TREE #0 *)
  19.       HUELLK1 = 10;      (* OBJECT in TREE #0 *)
  20.       HUELLK2 = 13;      (* OBJECT in TREE #0 *)
  21.       HUELLK3 = 15;      (* OBJECT in TREE #0 *)
  22.       TEST = 6;      (* OBJECT in TREE #0 *)
  23.       OKSOUND = 25;      (* OBJECT in TREE #0 *)
  24.       CANCELSO = 35;      (* OBJECT in TREE #0 *)
  25.       HKFREQU = 12;      (* OBJECT in TREE #0 *)
  26.       RAUSCHFR = 28;      (* OBJECT in TREE #0 *)
  27.       RAUSCH1 = 30;      (* OBJECT in TREE #0 *)
  28.       RAUSCH2 = 32;      (* OBJECT in TREE #0 *)
  29.       RAUSCH3 = 34;      (* OBJECT in TREE #0 *)
  30.       TON1 = 18;      (* OBJECT in TREE #0 *)
  31.       TON2 = 19;      (* OBJECT in TREE #0 *)
  32.       TON3 = 20;      (* OBJECT in TREE #0 *)
  33.       TONAN1 = 22;      (* OBJECT in TREE #0 *)
  34.       TONAN2 = 23;      (* OBJECT in TREE #0 *)
  35.       TONAN3 = 21;      (* OBJECT in TREE #0 *)
  36. ə
  37.  
  38.  
  39. VAR RSCfileName : ARRAY [0..80] OF CHAR;
  40.     OK : BOOLEAN;
  41.     diaret : INTEGER;
  42.     DiaAdr :ADDRESS;
  43.  
  44. PROCEDURE SetSoundHz(Channel,Freq :CARDINAL);
  45. VAR Sc : LONGCARD;
  46. BEGIN
  47.   IF Freq#0 THEN
  48.     Sc := 125000D;
  49.     Sound(Channel,VAL(CARDINAL,(Sc DIV  VAL(LONGCARD,Freq))))
  50.   END(*IF*);
  51. END  SetSoundHz;
  52.  
  53. PROCEDURE SetWaveLengthHz(Channel,Form, Freq :CARDINAL);
  54. BEGIN
  55.    IF Freq#0 THEN
  56.      Wave(Channel,Form,7812 DIV Freq)
  57.    END(*IF*);
  58. END  SetWaveLengthHz;
  59.  
  60. PROCEDURE SoundOff;
  61. BEGIN
  62.    SoundAndNoiseOnOff(7,7);
  63.    Wave(1,0,0);
  64.    Wave(2,0,0);
  65.    Wave(3,0,0)
  66. END SoundOff;
  67.  
  68. PROCEDURE DoSoundDial;
  69. VAR Huellkurve : CARDINAL;
  70.     OK :BOOLEAN;
  71.     Zahl : CARDINAL;
  72.     String : ARRAY [0..10] OF CHAR;
  73.     SoundFlag,NoiseFlag:CARDINAL;
  74. BEGIN
  75.     SoundOff;
  76.     Huellkurve:=11;
  77.     IF IsSelected(DREIECK,DiaAdr) THEN
  78.        Huellkurve:=10;
  79.     ELSIF  IsSelected(SAEGESTG,DiaAdr) THEN
  80.        Huellkurve:=12;
  81.     ELSIF  IsSelected(SAEGEFAL,DiaAdr) THEN
  82.        Huellkurve:=8;
  83.     END(*IF*);
  84.     SoundFlag:=0;NoiseFlag:=0; (* alles an ! *)
  85.     IF ~IsCrossed(TONAN1,DiaAdr) THEN (* wenn nicht angekreutzt *)
  86.        SoundFlag:=SoundFlag+1;        (* dann ausschalten *)
  87.     END(*IF*);
  88.     IF ~IsCrossed(TONAN2,DiaAdr) THEN
  89.        SoundFlag:=SoundFlag+2;
  90.     END(*IF*);
  91.     IF ~IsCrossed(TONAN3,DiaAdr) THEN
  92.        SoundFlag:=SoundFlag+4;
  93.     END(*IF*);
  94.     IF ~IsCrossed(RAUSCH1,DiaAdr) THEN
  95.        NoiseFlag:=NoiseFlag+1;
  96.     END(*IF*);
  97.     IF ~IsCrossed(RAUSCH2,DiaAdr) THEN
  98.        NoiseFlag:=NoiseFlag+2;
  99.     END(*IF*);
  100.     IF ~IsCrossed(RAUSCH3,DiaAdr) THEN
  101.        NoiseFlag:=NoiseFlag+4;
  102.     END(*IF*);
  103.     GetText(LAUTST1,DiaAdr,String);
  104.     StrToCard(String,Zahl,OK);
  105.     Volume(1,Zahl);
  106.     GetText(LAUTST2,DiaAdr,String);
  107.     StrToCard(String,Zahl,OK);
  108.     Volume(2,Zahl);
  109.     GetText(LAUTST3,DiaAdr,String);
  110.     StrToCard(String,Zahl,OK);
  111.     Volume(3,Zahl);
  112.     GetText(TON1,DiaAdr,String);
  113.     StrToCard(String,Zahl,OK);
  114.     SetSoundHz(1,Zahl);
  115.     GetText(TON2,DiaAdr,String);
  116.     StrToCard(String,Zahl,OK);
  117.     SetSoundHz(2,Zahl);
  118.     GetText(TON3,DiaAdr,String);
  119.     StrToCard(String,Zahl,OK);
  120.     SetSoundHz(3,Zahl);
  121.     GetText(RAUSCHFR,DiaAdr,String);
  122.     StrToCard(String,Zahl,OK);
  123.     Noise(Zahl);
  124.     GetText(HKFREQU,DiaAdr,String);
  125.     StrToCard(String,Zahl,OK);
  126.     IF IsSelected(HUELLK1,DiaAdr) THEN
  127.        SetWaveLengthHz(1,Huellkurve,Zahl);
  128.     END(*IF*);
  129.     IF  IsSelected(HUELLK2,DiaAdr) THEN
  130.        SetWaveLengthHz(2,Huellkurve,Zahl);
  131.     END(*IF*);
  132.     IF  IsSelected(HUELLK3,DiaAdr) THEN
  133.        SetWaveLengthHz(3,Huellkurve,Zahl);
  134.     END(*IF*);
  135.     SoundAndNoiseOnOff(NoiseFlag,SoundFlag); (* Ton und Rauschgeneratoren ein *)
  136. END DoSoundDial;
  137.  
  138. BEGIN
  139.     RSCfileName :='Sound.rsc';
  140.     Init;
  141.     OK:=InitResource(-1,-1,RSCfileName);
  142.     (*GrafMouse(Arrow,NIL);*)
  143.     ResourceGetAddr(0,TREE1,DiaAdr);
  144.     REPEAT
  145.       diaret:=DoMoveDialog(DiaAdr,LAUTST1);
  146.       IF diaret=TEST THEN DoSoundDial
  147.       ELSE SoundOff;
  148.       END(*IF*);
  149.     UNTIL diaret=OKSOUND;
  150.     Terminate;
  151.     DOSound.Hymne
  152. END SoundGem.
  153.